home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / ANC_UTULITYS_16.adf / CheckHop (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-09-21  |  7KB  |  236 lines
  1. SAY TRANSLATE$("")
  2. SCREEN 2,640,200,3,2
  3. WINDOW 2,"",,0,2
  4. DIM red(44),s(7,7),s1(47),s2(47),s3(47),s4(47)
  5. ON ERROR GOTO EH
  6. GOSUB MakeScreen
  7. Start:Numleft=48
  8. FOR J=6 TO 7:FOR i=0 TO 7:s(i,J)=1:NEXT i,J
  9. FOR J=0 TO 1:FOR i=0 TO 7:s(i,J)=1:NEXT i,J
  10. FOR J=0 TO 7:FOR i=0 TO 1:s(i,J)=1:NEXT i,J
  11. FOR J=0 TO 7:FOR i=6 TO 7:s(i,J)=1:NEXT i,J
  12. GOSUB PlaceCheckers
  13. IF qq$="V" THEN View
  14. 150 LOCATE 1,1:PRINT SPACE$(80):LOCATE 1,1:PRINT "From ";    
  15. 160 IF MOUSE(0)<>0 THEN 160                                
  16. 170 IF MOUSE(0)=0 THEN 170
  17. col=MOUSE(1):row=MOUSE(2)
  18. IF col>19 AND col<106 AND row>126 AND row<146 THEN Win
  19. GOSUB Calc
  20. IF col<0 OR col>7 OR row<0 OR row>7 THEN 150
  21. PRINT col;" ";row:e=col:h=row
  22. IF e<0 OR h<0 THEN BEEP:GOTO 150
  23. IF s(e,h)=0 THEN BEEP:GOTO 150
  24. 180 LOCATE 1,30:PRINT SPACE$(15):LOCATE 1,30:PRINT "To ";      
  25. IF MOUSE(0)=-1 THEN
  26. 185 IF MOUSE(0)=0 THEN 205 :ELSE 185
  27. END IF
  28. 190 IF MOUSE(0)<>0 THEN 190                 
  29. 200 IF MOUSE(0)=0 THEN 200
  30. 205 col=MOUSE(1):row=MOUSE(2)
  31. IF col>19 AND col<106 AND row>126 AND row<146 THEN Win
  32. GOSUB Calc
  33. a=col:b=row:IF a=e AND b=h THEN 180
  34. IF col<0 OR col>7 OR row<0 OR row>7 THEN BEEP:GOTO 150
  35. IF s(col,row)=1 THEN BEEP:SAY TRANSLATE$("You must land in a blank space."):GOTO 150
  36. m1=(e+a)/2:m2=(h+b)/2
  37. IF e=a OR b=h OR ABS(e-a)<>2 OR ABS(h-b)<>2 OR s(m1,m2)=0 THEN SAY TRANSLATE$("You must jump dyagnauly over a checker"):GOTO 150
  38. PRINT col;" ";row
  39. s(e,h)=0:s(m1,m2)=0:s(a,b)=1
  40. GOSUB move
  41. GOTO 150
  42. Win:
  43. Jumped=48-Numleft
  44. CALL SayNumber(Jumped,J$)
  45. SAY TRANSLATE$("You succesfully jumped over "+J$+" checkers")
  46. CALL SayNumber(Numleft-1,J$)
  47. SAY TRANSLATE$("and had "+J$+" jumps remaining.")
  48. IF Jumped<25 THEN
  49. SAY TRANSLATE$("I'm sorry, but you really didn't do very good.")
  50. END IF
  51. IF Jumped>24 AND Jumped<30 THEN
  52. SAY TRANSLATE$("You did o.k.")
  53. END IF
  54. IF Jumped>29 AND Jumped<40 THEN
  55. SAY TRANSLATE$("You did a pretty good job.")
  56. END IF
  57. IF Jumped>39 AND Jumped<45 THEN
  58. SAY TRANSLATE$("That is terrific. I'm proud of you.")
  59. END IF
  60. IF Jumped>44 AND Jumped<47 THEN
  61. SAY TRANSLATE$("Wow. That is really sooper. That is great. Thank you for playing")
  62. END IF
  63. IF Jumped>46 THEN
  64. SAY TRANSLATE$("I am flabbergasted. I don't know what to say. That is terrific. Congratulations on a fine job.")
  65. END IF
  66. LOCATE 10,1:PRINT "Save Game?":PRINT "(Y/N)"
  67. SAY TRANSLATE$("Would you like to save this game")
  68. 315 a$=UCASE$(INKEY$):IF a$="" OR (a$<>"Y" AND a$<>"N") THEN 315
  69. IF a$="Y" THEN
  70. LOCATE 10,1:PRINT SPACE$(10):PRINT SPACE$(5)
  71. SAY TRANSLATE$("What would you like to name it")
  72. LOCATE 10,1:PRINT "Name:":INPUT GameName$
  73. OPEN GameName$ FOR OUTPUT AS 1
  74. PRINT #1,Numleft
  75. FOR i=0 TO 47-Numleft
  76. PRINT #1,s1(i),s2(i),s3(i),s4(i)
  77. NEXT i
  78. CLOSE #1
  79. END IF
  80. LOCATE 10,1:PRINT "Play Again?":PRINT "(Y/N)   "
  81. SAY TRANSLATE$("Would you like to play again")
  82. 320 a$=UCASE$(INKEY$):IF a$="" OR (a$<>"Y" AND a$<>"N") THEN 320
  83. IF a$="Y" THEN
  84. CLS:GOSUB Ask
  85. GOSUB draw
  86. FOR y=0 TO 7:FOR x=0 TO 7:s(x,y)=0:NEXT x,y
  87. GOTO Start
  88. ELSE
  89. SAY TRANSLATE$("by by."):SYSTEM
  90. END IF
  91. move:
  92. ee=e*50+160
  93. hh=h*20+31
  94. aa=a*50+160
  95. bb=b*20+31
  96. LINE(ee-24,hh-9)-(ee+24,hh+9),6,bf
  97. PUT(aa-12,bb-5),red,PSET
  98. SOUND 10000,0.05
  99. cc=m1*50+160
  100. rr=m2*20+31
  101. LINE(cc-24,rr-9)-(cc+24,rr+9),6,bf
  102. Numleft=Numleft-1
  103. LOCATE 5,1:PRINT "Jumps: ";48-Numleft
  104. LOCATE 7,1:PRINT "To go: ";Numleft-1
  105. g=47-Numleft
  106. s1(g)=e:s2(g)=h
  107. s3(g)=a:s4(g)=b
  108. IF Numleft=1 THEN Win
  109. RETURN
  110. PlaceCheckers:
  111. FOR y=0 TO 7
  112. FOR x=0 TO 7
  113. xx=x*50+160
  114. yy=y*20+31
  115. IF s(x,y)=1 THEN PUT(xx-12,yy-5),red,PSET
  116. NEXT x,y
  117. RETURN
  118. Calc:
  119. IF col>135 AND col<185 THEN col=0
  120. IF col>185 AND col<235 THEN col=1
  121. IF col>235 AND col<285 THEN col=2
  122. IF col>285 AND col<335 THEN col=3
  123. IF col>335 AND col<385 THEN col=4
  124. IF col>385 AND col<435 THEN col=5
  125. IF col>435 AND col<485 THEN col=6
  126. IF col>485 AND col<535 THEN col=7
  127. IF row>21 AND row<41 THEN row=0
  128. IF row>41 AND row<61 THEN row=1
  129. IF row>61 AND row<81 THEN row=2
  130. IF row>81 AND row<101 THEN row=3
  131. IF row>101 AND row<121 THEN row=4
  132. IF row>121 AND row<141 THEN row=5
  133. IF row>141 AND row<161 THEN row=6
  134. IF row>161 AND row<181 THEN row=7
  135. RETURN
  136. View:
  137. LOCATE 1,1:INPUT "Name of game";GameName$
  138. OPEN GameName$ FOR INPUT AS 1
  139. INPUT #1,Numleft
  140. z=47-Numleft:Numleft=48
  141. FOR i=0 TO z
  142. INPUT #1,s1(i),s2(i),s3(i),s4(i)
  143. NEXT i
  144. CLOSE #1
  145. FOR i=0 TO z
  146. e=s1(i)
  147. h=s2(i)
  148. a=s3(i)
  149. b=s4(i)
  150. m1=(e+a)/2:m2=(h+b)/2
  151. s(e,h)=0:s(m1,m2)=0:s(a,b)=1
  152. GOSUB move
  153. 325 a$=INKEY$:IF a$="" THEN 325
  154. IF a$=CHR$(27) THEN 150
  155. NEXT i
  156. GOTO Win
  157. Ask:
  158. LOCATE 19,26:PRINT "Press 'P' to play a game"
  159. LOCATE 21,26:PRINT "Press 'V' to view a game"
  160. 330 qq$=UCASE$(INKEY$):IF qq$="" OR (qq$<>"P" AND qq$<>"V") THEN 330
  161. IF qq$="V" THEN
  162. CLS
  163. LOCATE 5,2:PRINT "While viewing a game you may press 'ESC' to start playing at a certain point."
  164. LOCATE 7,14:PRINT "Press any other key to advance to the next move"
  165. LOCATE 21,32:PRINT "Press any Key"
  166. 335 a$=INKEY$:IF a$="" THEN 335
  167. END IF
  168. RETURN
  169. MakeScreen:
  170. LOCATE 2,35:PRINT "Checker Hop"
  171. PRINT TAB(39);"by"
  172. PRINT TAB(35);"Steve Carr"
  173. LOCATE 7,5:PRINT "The object of this game is to remove as many checkers as possible"
  174. PRINT TAB(5);"by diagonal jumps (as in standard checkers)"
  175. LOCATE 10,3:PRINT "TO move - click the piece you want to move and then click on the spot"
  176. PRINT TAB(13);"where you want it"
  177. PRINT TAB(8);"Or - click the piece you want to move, hold the button down,"
  178. PRINT TAB(13);"and let go of it over the spot you want the checker"
  179. LOCATE 15,22:PRINT "To give up click in the give up box"
  180. LOCATE 17,6:PRINT "TO cancel a move after choosing (from) - click in the brown area"
  181. GOSUB Ask
  182. PALETTE 0,0.6,0.33,0       'brown
  183. PALETTE 1,0.6,0.33,0       'brown
  184. PALETTE 2,0.8,0,0         'red
  185. PALETTE 4,1,0.4,0         'orange
  186. PALETTE 6,0.8,0.8,0.8       'light grey
  187. PALETTE 7,0,0,0          'black
  188. COLOR 7,6:CLS
  189. CIRCLE(162,32),14,7
  190. PAINT (162,32),7,7
  191. CIRCLE (160,31),14,2
  192. PAINT (160,31),4,2
  193. CIRCLE (160,31),14,7
  194. CIRCLE (160,31),9,7
  195. PAINT(160,31),2,7
  196. GET(146,25)-(176,38),red
  197. draw:COLOR 7,0:CLS
  198. LINE(19,126)-(106,146),7,b
  199. LOCATE 17,7:PRINT "Give"
  200. LOCATE 18,8:PRINT "Up"
  201. COLOR 1,0
  202. LINE(136,22)-(534,180),6,bf
  203. FOR i=21 TO 181 STEP 20
  204. LINE(135,i)-(535,i),7
  205. NEXT i
  206. FOR i=135 TO 535 STEP 50
  207. LINE(i,21)-(i,181),7
  208. NEXT i
  209. LINE(134,21)-(134,181),7
  210. LINE(535,21)-(551,26),7
  211. LINE -(551,186),7
  212. LINE -(148,186),7
  213. LINE -(135,181),7
  214. PAINT(549,30),7,7
  215. COLOR 7,0
  216. RETURN
  217. EH:
  218. SAY TRANSLATE$("That file does not exist. Program will restart."):CLEAR:RUN
  219. SUB SayNumber(a,talk$) STATIC
  220. IF a<10 THEN talk$=STR$(a)
  221. a$=STR$(a)
  222. a1$=LEFT$(a$,1)
  223. a2$=RIGHT$(a$,1)
  224. IF a>9 AND a<20 THEN talk$=a2$+" teen"
  225. IF a=10 THEN talk$="ten"
  226. IF a=11 THEN talk$="eh-lehven"
  227. IF a=12 THEN talk$="twelve"
  228. IF a=13 THEN talk$="thirteen"
  229. IF a=15 THEN talk$="fifteen"
  230. IF a>19 AND a<30 THEN talk$="twenty "+a2$
  231. IF a>29 AND a<40 THEN talk$="thirty "+a2$
  232. IF a>39 AND a<50 THEN talk$="fourty "+a2$
  233. IF RIGHT$(talk$,1)="0" THEN talk$=LEFT$(talk$,LEN(talk$)-1)
  234. END SUB
  235.  
  236.